{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}


module Stepwise where

import Control.Monad.Error
import qualified Data.Map as Map
import Result
import Accessor


class Monad m => Sibling m r where
    (>>>=) :: r a -> (a -> m b) -> r b


data Stepwise s e r a = Stepwise { step :: s -> (s, Result e (Either a (r a))) }


instance Sibling (Stepwise s e r) r => Monad (Stepwise s e r) where
    return a = Stepwise $ \s -> (s, Success $ Left a)

    Stepwise f >>= g = Stepwise aux
        where
          aux s = case f s of
                    (s', Failure e)          -> (s', Failure e)
                    (s', Success (Left a))   -> step (g a) s'
                    (s', Success (Right f')) -> (s', Success $ Right $ f' >>>= g)


instance Sibling (Stepwise s e r) r => WithState (Stepwise s e r) s where
    getCurrentState    = Stepwise $ \s -> (s, Success $ Left s)
    setCurrentState s' = Stepwise $ \s -> (s', Success $ Left ())


instance Sibling (Stepwise s e r) r => MonadError e (Stepwise s e r) where
    throwError e = Stepwise $ \s -> (s, Failure e)
    
    catchError try catch = Stepwise aux
        where
          aux s = case step try s of
                    (s', Failure e) -> step (catch e) s'
                    (s', Success r) -> (s', Success r)


failure :: e -> Stepwise s e r a
--------------------------------
failure e = Stepwise $ \s -> (s, Failure e)


yield :: r a -> Stepwise s e r a
--------------------------------
yield x = Stepwise $ \s -> (s, Success $ Right x)
